home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / BLOCK.ASM < prev    next >
Encoding:
Assembly Source File  |  1992-11-18  |  8.4 KB  |  272 lines
  1. ;* BLOCK.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*            Block Allocation                *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. SMALL_SIZE    = 1024            ; space in page not worth searching
  29.  
  30. CODESEG
  31.  
  32. ;************************************************************************
  33. ;*    ALLOC_BLOCK                            *
  34. ;*                                    *
  35. ;* calling sequence:    alloc_block(reg, type, size)            *
  36. ;************************************************************************
  37. PROC C    alloc_block USES es di si, $$reg:WORD, $$type:WORD, $$size:WORD
  38.     LOCAL    @@stringsize:WORD
  39.  
  40.     mov    ax, [$$size]
  41.     mov    [@@stringsize], ax
  42.     cmp    [$$type], STRTYPE    ; is it a string?
  43.     jne    @@notsmall
  44.     cmp    ax, SIZE POINTER    ; is it a small string?
  45.     jge    @@notsmall
  46.     mov    [$$size], SIZE POINTER
  47. @@notsmall:
  48.     add    [$$size], OFFSET (TYPE ANYDEF).data
  49.  
  50.     call    search_block        ; search page type chain for block
  51.     jnc    @@failed
  52.     jmp    @@done
  53.  
  54. @@failed:                ; Didn't find a block, search a new page
  55.     mov    ax, [$$size]
  56.     cmp    [emspages], 0
  57.     jne    @@findapage
  58.     cmp    ax, [defpagesize]    ; without EMS, we can't find a larger one
  59.     jae    @@findabigone
  60. @@findapage:
  61.     call    alloc_page C, [$$type], ax
  62.     cmp    ax, END_LIST        ; did we succeed?
  63.     jne    @@newpagefound
  64.                     ; no more pages, try a garbage collection,
  65.                     ; then search the pages again for a free block
  66.     mov    si, [$$reg]
  67.     mov    [(REG si).page], NIL_PAGE*2 ; clear reg before GC
  68.     call    garbage C
  69.     call    search_block
  70.     jc    @@done
  71. ; Still couldn't find a block large enough, try to allocate a new page once
  72. ; again (since we just did a garbage collection).
  73.     call    alloc_page C, [$$type], [$$size]
  74.     cmp    ax, END_LIST        ; did we succeed?
  75.     jnz    @@newpagefound
  76. ; We're getting desperate now. Try a collection with compaction, then try to
  77. ; allocate a new page for the object
  78.     mov    si, [$$reg]
  79.     mov    [(REG si).page], NIL_PAGE*2 ; clear for possible GC
  80.     call    gcsquish C
  81.     call    alloc_page C, [$$type], [$$size]
  82.     cmp    ax, END_LIST        ; did we succeed?
  83.     jne    @@newpagefound
  84. @@findabigone:
  85.     mov    si, [$$reg]        ; try allocating a big block, then
  86.     mov    [(REG si).page], NIL_PAGE*2 ; clear ret reg in case of GC
  87.     call    alloc_big_block C, si, [$$type], [$$size]
  88.     jmp    @@done
  89.  
  90. @@newpagefound:                ; ax is the page # found
  91.     push    es            ; save es over C call
  92.     call    find_block C, [$$reg], [$$type], [$$size], ax
  93.     pop    es
  94.     or    ax, ax            ; ax nul = success
  95.     jnz    @@error
  96. @@done:                    ; We have found a block, set up the header and return
  97.     cmp    [$$type], STRTYPE
  98.     jne    @@ret
  99.     cmp    [@@stringsize], SIZE POINTER
  100.     jge    @@ret
  101.     push    es            ; for small strings, put the negative value for object length
  102.     mov    si, [$$reg]
  103.     mov    bx, [(REG si).page]
  104.     mov    si, [(REG si).disp]
  105.     ldpage    es, bx
  106.     mov    cx, [@@stringsize]
  107.     sub    cx, SIZE POINTER
  108.     mov    [(STRDEF es:si).len], cx
  109.     pop    es
  110. @@ret:
  111.     ret
  112.  
  113. @@error:
  114.     call    out_of_memory C
  115.     jmp    @@ret            ; control will not return here
  116.  
  117. ;************************************************************************
  118. ;* SRCH_BLOCK - Search through all the pages of a given type looking    *
  119. ;* for a block large enough to fill the size request.            *
  120. ;*                                    *
  121. ;* Upon Exit:    Carry Flag set, $$reg will point to the block.        *
  122. ;*        Carry Flag clear, $$reg will contain a page # of -1    *
  123. ;************************************************************************
  124. PROC    search_block    NEAR
  125.     mov    si, [$$type]
  126.     lea    bx, [pagelist+si]
  127.     push    bx            ; save the last page
  128.     mov    ax, [pagelist+si]    ; ax = page number for this type
  129.     cmp    ax, END_LIST        ; any pages to search?
  130.     clc                ; carry clear = failure
  131.     je    @@searchend
  132. @@searchloop:
  133.     mov    si, ax            ; save page number for later
  134.     call    find_block C, [$$reg], [$$type], [$$size], ax
  135.     or    ax, ax            ; ax nul = success
  136.     stc                ; assume success
  137.     jz    @@searchend
  138. ; Block not found within current page.
  139.     shl    si, 1            ; make page # into index
  140.     cmp    [$$size], SMALL_SIZE
  141.     jg    @@searchbigenough
  142. ; less than small_size space is left within the page; this isn't worth searching
  143. ; again, so update the last position in the chain (last page) to point to the
  144. ; next page in the chain.
  145.     mov    ax, [pagelink+si]
  146.     pop    di            ; peep at the last page
  147.     push    di
  148.     mov    [di], ax
  149. @@searchbigenough:
  150. ; update last_page to contain the address of the next position in the chain,
  151. ; and get the next page from pagelink[page].
  152.     lea    bx, [pagelink+si]
  153.     pop    ax            ; trash & reload the last page
  154.     push    bx
  155.     mov    ax, [bx]
  156.     cmp    ax, END_LIST        ; reached end of chain?
  157.     jne    @@searchloop
  158.     clc                ; carry clear = failure
  159. @@searchend:
  160.     pop    ax            ; trash off the last page
  161.     ret
  162. ENDP    search_block
  163. ENDP    alloc_block
  164.  
  165. ;************************************************************************
  166. ;*    FIND_BLOCK                            *
  167. ;*                                    *
  168. ;* calling sequence:    find_block(reg, type, size, page)        *
  169. ;*                                    *
  170. ;* Upon Exit:    ax = 0: reg contains page:displ of new block        *
  171. ;*        ax = -1: reg contains page of -1            *
  172. ;************************************************************************
  173. PROC C    find_block USES si di, @@reg:WORD, @@type:WORD, @@size:WORD, @@page:WORD
  174.  
  175.     mov    si, [@@reg]
  176.     mov    [(REG si).page], -1 ; default to block not found
  177.  
  178.     mov    si, [@@page]        ; get page number
  179.     shl    si, 1
  180.     ldpage    es, si
  181.  
  182.     mov    bx, [nextcell+si]    ; lets see if there's space in the free pool of this block
  183.     cmp    bx, END_LIST
  184.     je    @@pageempty
  185.     mov    ax, [(FREEDEF es:bx).len]
  186.     mov    dx, [@@size]
  187.     cmp    ax, dx
  188.     jl    @@pageempty
  189.  
  190. ; allocate a block from the free pool.
  191. ; ax = free pool size, bx = displacement, dx = object size
  192.     mov    cx, [@@type]
  193.     mov    [(ANYDEF es:bx).tag], cl
  194.     mov    [(ANYDEF es:bx).len], dx
  195.     mov    di, bx
  196.     add    di, dx            ; di is end of new block
  197.     mov    cx, [psize+si]        ; get page size
  198.     sub    cx, OFFSET (TYPE ANYDEF).data
  199.     cmp    cx, di            ; next disp still in page?
  200.     jb    @@pagefull
  201.     mov    [(FREEDEF es:di).tag], FREETYPE
  202.     sub    ax, dx            ; ax = pool size - object size
  203.     mov    [(FREEDEF es:di).len], ax
  204.     mov    [nextcell+si], di
  205.     jmp    @@done
  206. @@pagefull:
  207.     mov    [nextcell+si], END_LIST
  208.     jmp    @@done
  209.  
  210. ; A block was not found in the free pool. Search the entire block for a fragment
  211. ; to satisfy the request.
  212. @@pageempty:
  213.     xor    bx, bx            ; bx = displacement
  214.     mov    cx, [psize+si]
  215.     sub    cx, [@@size]        ; cx = displacement threshold
  216.     cmp    cx, bx
  217.     mov    ax, -1            ; zero flag not set = failure
  218.     jl    @@ret            ; return with no block found
  219.  
  220. @@loop:                    ; the following loop requires bx=displacement, cx=threshold, dx=free size
  221.     mov    dx, [(ANYDEF es:bx).len]
  222.     cmp    [(ANYDEF es:bx).tag], FREETYPE
  223.     je    @@found
  224. @@infactnotfound:
  225.     mov    ax, OFFSET (TYPE STRDEF).buffer + SIZE POINTER ; ax = ovhd for small string
  226.     or    dx, dx
  227.     js    @@smallstring
  228.     mov    ax, dx            ; else ax = size of object
  229. @@smallstring:
  230.     add    bx, ax            ; displacement += size
  231.     cmp    cx, bx            ; disp <= threshold ?
  232.     jge    @@loop
  233.     mov    ax, -1            ; zero flag not set = failure
  234.     jmp    @@ret            ; return with no block found
  235.  
  236. ;we have found a free space in the block; if not big enough then jump back
  237. ;into loop above, otherwise allocate the new storage
  238. @@found:
  239.     mov    ax, [@@size]
  240.     cmp    ax, dx            ; compare size to free size
  241.     jl    @@infactnotfound
  242.     jne    @@partialmatch
  243.     mov    ax, [@@type]        ; we found an exact match
  244.     mov    [(ANYDEF es:bx).tag], al
  245.     jmp    @@done
  246. @@partialmatch:
  247.     mov    di, dx
  248.     sub    di, OFFSET (TYPE ANYDEF).data
  249.     cmp    di, ax            ; can an object fit into the free space?
  250.     jle    @@infactnotfound
  251. ; we can fit into a larger block, split block to allocate storage
  252.     mov    cx, [@@type]
  253.     mov    [(ANYDEF es:bx).tag], cl
  254.     mov    [(ANYDEF es:bx).len], ax
  255.     mov    di, bx            ; ax=new object size, bx=disp, dx=free size
  256.     add    di, ax            ; update to end of block
  257.     sub    dx, ax            ; free size - new size
  258.     mov    [(FREEDEF es:di).tag], FREETYPE
  259.     mov    [(FREEDEF es:di).len], dx
  260. ; block found; return page,disp in return register.
  261. ; si = page index, bx = displacement
  262. @@done:
  263.     mov    di, [@@reg]
  264.     mov    [(REG di).page], si
  265.     mov    [(REG di).disp], bx
  266.     xor    ax, ax            ; ax nul = success
  267. @@ret:
  268.     ret
  269. ENDP    find_block
  270.  
  271.     END
  272.